home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / msdos / ctest259.zip / WHET.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-09  |  7KB  |  250 lines
  1. {$A+,B-,D-,E+,F-,G-,I-,L-,N+,O-,R-,S-,V-,X-}
  2. {$M 4096,0,655360}
  3.  
  4. UNIT Whet;
  5.  
  6. INTERFACE
  7.  
  8. FUNCTION WhetStone (Emu: BOOLEAN; Index: DOUBLE): DOUBLE;
  9.  
  10. IMPLEMENTATION
  11.  
  12. { (C) Copyright, A H J Sale and British Standards Institution, 1982 }
  13. {TEST 1.2-1, CLASS=QUALITY}
  14.  
  15. {: This program is a general check on execution speed. }
  16. {  For details, see Computer Journal article, 'A Synthetic
  17.    Benchmark', Jan 1976  pp43-49. }
  18. {V3.0: New test. }
  19. {V5.1: Modified to introduce validation checks, 88-02-24}
  20.  
  21. { The validation checks added have been made to avoid printing
  22. values out which have no obvious purpose. In conversion to other
  23. languages, the printing may cause timing problems. Merely
  24. removing the printing statements is inadequate since then an
  25. optimizing compiler could remove many of the modules completely. }
  26.  
  27. { For details of checks and changes to avoid some problems,
  28.   see NPL report DITC 107/88. }
  29.  
  30. uses time;
  31.  
  32. type
  33.     real = double;
  34.     rlarray = array [ 1 .. 4 ] of real;
  35.  
  36. const
  37.     t = 0.499975;
  38.     t1 = 0.50025;
  39.     t2 = 2.0;
  40.  
  41.  
  42. var
  43.     start, stop: integer;
  44.     wt: integer;  { Determines length of execution }
  45.     x, y, z, norm, t3, estimate: real;
  46.     xx: record
  47.         one, two, three, four: real
  48.         end;
  49.     e1: rlarray;
  50.     i, jj, kk, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11: integer;
  51.     ij, ik, il: 1 .. 4;
  52.     fail: boolean;
  53.  
  54.  
  55.     procedure pa(var e: rlarray);
  56.         label 1;
  57.         var j: integer;
  58.         begin
  59.         j := 0;
  60.       1 :
  61.         e[1] := (e[1] + e[2] + e[3] - e[4]) * t;
  62.         e[2] := (e[1] + e[2] - e[3] + e[4]) * t;
  63.         e[3] := (e[1] - e[2] + e[3] + e[4]) * t;
  64.         e[4] := ( - e[1] + e[2] + e[3] + e[4]) / t3; {changed from t2}
  65.         j := j + 1;
  66.         if j < 6 then
  67.             goto 1
  68.         end; {pa}
  69.  
  70.     procedure p0;
  71.         begin
  72.         e1[ij] := e1[ik];
  73.         e1[ik] := e1[il];
  74.         e1[il] := e1[ij];
  75.         end; {p0}
  76.  
  77.     procedure p3(x, y: real; var z: real);
  78.         begin
  79.         x := t * (z + x);
  80.         y := t * (x + y);
  81.         z := (x + y) / t2
  82.         end; {p3}
  83.  
  84.     procedure Check(ModuleNo: integer; Condition: Boolean);
  85.         begin
  86.         if not Condition then
  87.            begin
  88.            writeln('Module ', ModuleNo:1, ' has not produced the expected',
  89.                    ' results');
  90.            writeln('Check listing and compare with Pascal version');
  91.            fail := true
  92.            end
  93.         end;
  94.  
  95. FUNCTION WhetStone (Emu: BOOLEAN; Index: DOUBLE): DOUBLE;
  96.  
  97. BEGIN
  98.     IF Emu THEN
  99.        wt := 1
  100.     ELSE
  101.        wt := Round (index / 3 + 1); { 10 corresponds to one million Whetstone
  102.                  instructions
  103.                  value shouldbe read to avoid the loop counters being
  104.                  taken as constant. }
  105.     fail := false;
  106. (*    Check( 0, (wt >= 1) and (wt <= 100) );*)
  107.     n1 := 2 * wt;
  108.     n2 := 10 * wt;
  109.     n3 := 14 * wt;
  110.     n4 := 345 * wt;
  111.     n5 := 0;
  112.     n6 := 95 * wt;
  113.     n7 := 32 * wt;
  114.     n8 := 800 * wt;
  115.     n9 := 616 * wt;
  116.     n10 := 0;
  117.     n11 := 93 * wt;
  118.  
  119.     start := clock;
  120.  
  121.     { module 1: simple identifiers}
  122.     xx.one := 1.0;
  123.     xx.two := -1.0;  xx.three := -1.0;  xx.four := -1.0;
  124.     for i := 1 to n1 do
  125.         begin
  126.         xx.one := (xx.one + xx.two + xx.three - xx.four) * t;
  127.         xx.two := (xx.one + xx.two - xx.three + xx.four) * t;
  128.         xx.three := (xx.one - xx.two + xx.three + xx.four) * t;
  129.         xx.four := ( - xx.one + xx.two + xx.three + xx.four) * t
  130.         end; {module 1}
  131.     with xx do
  132.         norm := sqrt(sqr(one)+sqr(two)+sqr(three)+sqr(four));
  133. (*    Check(1, abs(norm - exp(0.35735-n1*6.1e-5))/norm <= 0.1 );*)
  134.  
  135.     { module 2: array elements}
  136.     e1[1] := 1.0;
  137.     e1[2] := -1.0;  e1[3] := - 1.0;  e1[4] := - 1.0;
  138.     for i := 1 to n2 do
  139.         begin
  140.         e1[1] := (e1[1] + e1[2] + e1[3] - e1[4]) * t;
  141.         e1[2] := (e1[1] + e1[2] - e1[3] + e1[4]) * t;
  142.         e1[3] := (e1[1] - e1[2] + e1[3] + e1[4]) * t;
  143.         e1[4] := ( - e1[1] + e1[2] + e1[3] + e1[4]) * t
  144.         end; {module 2}
  145. (*    norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));*)
  146. (*    Check(2, abs(norm - exp(0.35735-n2*6.1e-5))/norm <= 0.1);*)
  147.  
  148.     { module 3: array as parameter}
  149.     t3 := 1.0/t;
  150.     for i := 1 to n3 do
  151.         pa(e1);
  152. (*    norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));*)
  153. (*    Check(3, abs(norm - exp(0.35735-(n3*5+n2)*6.1e-5))/norm <= 0.1 );*)
  154.  
  155.     { module 4: conditional jumps}
  156.     jj := 1;
  157.     for i:= 1 to n4 do
  158.         begin
  159.         if jj = 1 then
  160.             jj := 2
  161.         else
  162.             jj := 3;
  163.         if jj > 2 then
  164.             jj := 0
  165.         else
  166.             jj := 1;
  167.         if jj < 1 then
  168.             jj := 1
  169.         else
  170.             jj := 0
  171.         end; {module 4}
  172. (*    Check( 4, jj = ord(not odd(wt) ) );*)
  173.  
  174.     { module 5: omitted}
  175.  
  176.     { module 6: integer arithmetic}
  177.     ij := 1;
  178.     ik := 2;
  179.     il := 3;
  180.     for i := 1 to n6 do
  181.         begin
  182.         ij := ij * (ik - ij) * (il - ik);
  183.         ik := il * ik - (il - ij) * ik;
  184.         il := (il - ik) * (ik + ij);
  185.         e1[il - 1] := ij + ik + il;
  186.         e1[ik - 1] := ij * ik * il
  187.         end; {module 6}
  188. (*    Check( 6, (ij=1) and (ik=2) and (il=3) );*)
  189.  
  190.     {module 7: trig. functions) }
  191.     x := 0.5;  y := 0.5;
  192.     for i := 1 to n7 do
  193.         begin
  194.         x := t * arctan(t2 * sin(x) * cos(x) /
  195.                         (cos(x + y) + cos (x - y) - 1.0));
  196.         y := t * arctan(t2 * sin(y) * cos(y) /
  197.                         (cos(x + y) + cos (x - y) - 1.0))
  198.         end; {module 7}
  199. (*    Check(7, (t - wt* 0.0015 <= x) and
  200.              (x <= t - wt* 0.0004) and
  201.              (t - wt* 0.0015 <= y) and
  202.              (y <= t - wt* 0.0004) );*)
  203.  
  204.     {module 8: procedure calls}
  205.     x := 1.0;  y := 1.0; z := 1.0;
  206.     for i := 1 to n8 do
  207.         p3(y * i, y + z, z);
  208. (*    Check(8, abs(z - (0.99983352*n8 - 0.999555651)) <= n8*1.0e-6);*)
  209.  
  210.     (* module 9: array references*)
  211.     ij := 1;
  212.     ik := 2;
  213.     il := 3;
  214.     e1[1] := 1.0;
  215.     e1[2] := 2.0;
  216.     e1[3] := 3.0;
  217.     for i := 1 to n9 do
  218.         p0;
  219. (*    Check(9, (e1[1] = 3.0) and (e1[2] = 2.0) and (e1[3] = 3.0) );*)
  220.  
  221.     { module 10: integer arithmetic}
  222.     jj := 2;
  223.     kk := 3;
  224.     for i := 1 to n10 do
  225.         begin
  226.         jj := jj + kk;
  227.         kk := jj + kk;
  228.         jj := kk - jj;
  229.         kk := kk - jj - jj;
  230.         end; {module 10}
  231. (*    Check(10, (jj=2) and (kk=3) );*)
  232.  
  233.     { module 11: standard functions}
  234.     x := 0.75;
  235.     for i := 1 to n11 do
  236.         x := sqrt (exp(ln(x) / t1));
  237. (*    estimate := 1.0 - exp(-0.0447*wt + ln(0.26));*)
  238. (*    Check( 11, (abs(estimate-x)/estimate
  239.                   <= 0.0006 + 0.065/(5+wt) ));*)
  240.  
  241.     stop := clock - start;
  242.     WhetStone := (100*wt/(stop*1e-3));
  243. end;
  244.  
  245. END. { Whet }
  246.  
  247.  
  248.  
  249.  
  250.